home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / totsrc11.zip / TOTSTR.PAS < prev    next >
Pascal/Delphi Source File  |  1993-05-04  |  22KB  |  906 lines
  1. {               Copyright 1991 TechnoJock Software, Inc.               }
  2. {                          All Rights Reserved                         }
  3. {                         Restricted by License                        }
  4.  
  5. {                             Build # 1.10                             }
  6.  
  7. Unit totSTR;
  8. {$I TOTFLAGS.INC}
  9.  
  10. {
  11.  Development Notes:  1.00a  6/11/91   Corrected RealSciStr for 0.0
  12.                      1.00b  2/03/92   Further corrections to RealToSciStr
  13.                                       and ValidInt
  14.                      1.00c  2/27/92   Remove double negative from RealtoSciStr
  15.                      1.00d  3/09/92   Changed NthNumber routine
  16. }
  17.  
  18. INTERFACE
  19.  
  20. Uses totREAL, totINPUT;
  21.  
  22. CONST
  23.    MaxFixlength = 5;
  24.  
  25. TYPE
  26.    tJust = (JustLeft,JustCenter,JustRight);
  27.    tCase = (Lower,Upper,Proper,Leave);
  28.    tSign = (plusminus, minus, brackets, dbcr);
  29.  
  30.    pFmtNumberOBJ = ^FmtNumberOBJ;
  31.    FmtNumberOBJ = object
  32.       vPrefix: string[Maxfixlength];
  33.       vSuffix: string[Maxfixlength];
  34.       vSign: tSign;
  35.       vPad: char;
  36.       vThousandsSep: char;
  37.       vDecimalSep: char;
  38.       vJustification: tJust;
  39.       {...methods}
  40.       constructor Init;
  41.       procedure   SetPrefixSuffix(P,S:string);
  42.       procedure   SetSign(S:tSign);
  43.       procedure   SetSeparators(P,T,D:char);
  44.       procedure   SetJustification(J:tJust);
  45.       function    GetDecimal:char;
  46.       function    FormattedStr(StrVal:string; Width:byte):string;
  47.       function    FormattedLong(Val:longint; Width:byte):string;
  48.       function    FormattedReal(Val:extended; DP:byte; Width:byte):string;
  49.       destructor  Done;
  50.    end; {FmtNumberOBJ}
  51.  
  52. CONST
  53.    Floating = 255;
  54.    Fmtchars: set of char = ['!','#','@','*'];
  55.  
  56. function PicFormat(Input,Picture:string;Pad:char): string;
  57. function TruncFormat(Input:string;Start,Len:byte; Pad:char):string;
  58. function Squeeze(L:char;Str:string;Width:byte): string;
  59. function First_Capital_Pos(Str:string): byte;
  60. function First_Capital(Str:string): char;
  61. function Pad(PadJust:tJust;Str:string;Size:byte;ChPad:char):string;
  62. function PadLeft(Str:string;Size:byte;ChPad:char):string;
  63. function PadCenter(Str:string;Size:byte;ChPad:char):string;
  64. function PadRight(Str:string;Size:byte;ChPad:char):string;
  65. function Last(N:byte;Str:string):string;
  66. function First(N:byte;Str:string):string;
  67. function AdjCase(NewCase:tCase;Str:string):string;
  68. function SetUpper(Str:string):string;
  69. function SetLower(Str:string):string;
  70. function SetProper(Str:string):string;
  71. function OverType(N:byte;StrS,StrT:string):string;
  72. function Strip(L,C:char;Str:string):string;
  73. function LastPos(C:char;Str:string):byte;
  74. function PosAfter(C:char;Str:string;Start:byte):byte;
  75. function LastPosBefore(C:char;Str:string;Last:byte):byte;
  76. function PosWord(Wordno:byte;Str:string):byte;
  77. function WordCnt(Str:string):byte;
  78. function ExtractWords(StartWord,NoWords:byte;Str:string):string;
  79. function ValidInt(Str:string):boolean;
  80. function ValidHEXInt(Str:string):boolean;
  81. function ValidReal(Str:string):boolean;
  82. function StrToInt(Str:string):integer;
  83. function StrToLong(Str:string):Longint;
  84. function HEXStrToLong(Str:string):longint;
  85. function StrToReal(Str:string):extended;
  86. function RealToStr(Number:extended;Decimals:byte):string;
  87. function IntToStr(Number:longint):string;
  88. function IntToHEXStr(Number:longint):string;
  89. function Decimals (L:byte):byte;
  90. function RealToSciStr(Number:extended; D:byte):string;
  91. function NthNumber(InStr:string;Nth:byte) : char;
  92.  
  93. IMPLEMENTATION
  94.  
  95. function PicFormat(Input,Picture:string;Pad:char): string;
  96. {}
  97. var
  98.    TempStr : string;
  99.    I,J : byte;
  100. begin
  101.    J := 0;
  102.    For I := 1 to length(Picture) do
  103.    begin
  104.        If not (Picture[I] in Fmtchars) then
  105.        begin
  106.            TempStr[I] := Picture[I] ;  {force any none format charcters into string}
  107.            inc(J);
  108.        end
  109.        else    {format character}
  110.        begin
  111.            If I - J <= length(Input) then
  112.               TempStr[I] := Input[I - J]
  113.            else
  114.               TempStr[I] := Pad;
  115.        end;
  116.    end;
  117.    TempStr[0] := char(length(Picture));  {set initial byte to string length}
  118.    PicFormat := Tempstr;
  119. end; {PicFormat}
  120.  
  121. function TruncFormat(Input:string;Start,Len:byte; Pad:char):string;
  122. {}
  123. var
  124.    L : byte;
  125. begin
  126.    if Start > 1 then
  127.       Delete(Input,1,pred(Start));
  128.    L := length(Input);
  129.    if L = Len then
  130.       TruncFormat := Input
  131.    else if L > Len then
  132.       TruncFormat := copy(Input,1,Len)
  133.    else
  134.       TruncFormat := Padleft(Input,Len,Pad);
  135. end; {TruncFormat}
  136.  
  137. function Squeeze(L:char; Str:string;Width:byte): string;
  138. {}
  139. const more:string[1] = #26;
  140. var temp : string;
  141. begin
  142.    if Width = 0 then
  143.    begin
  144.       Squeeze := '';
  145.       exit;
  146.    end;
  147.    Fillchar(Temp[1],Width,' ');
  148.    Temp[0] := chr(Width);
  149.    if Length(Str) < Width then
  150.       move(Str[1],Temp[1],length(Str))
  151.    else
  152.    begin
  153.       if upcase(L) = 'L' then
  154.       begin
  155.          move(Str[1],Temp[1],pred(width));
  156.          move(More[1],Temp[Width],1);
  157.       end
  158.       else
  159.       begin
  160.          move(More[1],Temp[1],1);
  161.          move(Str[length(Str)-width+2],Temp[2],pred(width));
  162.       end;
  163.    end;
  164.    Squeeze := Temp;
  165. end; {Squeeze}
  166.  
  167. function First_Capital_Pos(Str : string): byte;
  168. {}
  169. var StrPos : byte;
  170. begin
  171.    StrPos := 1;
  172.    while (StrPos <= length(Str))  and (AlphabetTOT^.IsUpper(ord(Str[StrPos])) = false) do
  173.       StrPos := Succ(StrPos);
  174.    if StrPos > length(Str) then
  175.       First_Capital_Pos  := 0
  176.    else
  177.       First_Capital_Pos := StrPos;
  178. end; {First_Capital_Pos}
  179.  
  180. function First_capital(Str : string): char;
  181. {}
  182. var B : byte;
  183. begin
  184.    B := First_Capital_Pos(Str);
  185.    if B > 0 then
  186.       First_Capital := Str[B]
  187.    else
  188.       First_Capital := #0;
  189. end; {First_capital}
  190.  
  191. function Pad(PadJust:tJust;Str:string;Size:byte;ChPad:char):string;
  192. {}
  193. begin
  194.    case PadJust of
  195.       JustLeft:  Pad := PadLeft(Str,Size,ChPad);
  196.       JustCenter:Pad := PadCenter(Str,Size,ChPad);
  197.       JustRight: Pad := PadRight(Str,Size,ChPad);
  198.    end; {case}
  199. end; {Pad}
  200.  
  201. function PadLeft(Str:string;Size:byte;ChPad:char):string;
  202. var temp : string;
  203. begin
  204.    fillchar(Temp[1],Size,ChPad);
  205.    Temp[0] := chr(Size);
  206.    if Length(Str) <= Size then
  207.       move(Str[1],Temp[1],length(Str))
  208.    else
  209.       move(Str[1],Temp[1],size);
  210.    PadLeft := Temp;
  211. end;
  212.  
  213. function PadCenter(Str:string;Size:byte;ChPad:char):string;
  214. var temp : string;
  215. L : byte;
  216. begin
  217.    fillchar(Temp[1],Size,ChPad);
  218.    Temp[0] := chr(Size);
  219.    L := length(Str);
  220.    if L <= Size then
  221.       move(Str[1],Temp[((Size - L) div 2) + 1],L)
  222.    else
  223.       Temp := copy(Str,1,L);
  224.    PadCenter := temp;
  225. end; {center}
  226.  
  227. function PadRight(Str:string;Size:byte;ChPad:char):string;
  228. var
  229.   temp : string;
  230.   L : integer;
  231. begin
  232.    fillchar(Temp[1],Size,ChPad);
  233.    Temp[0] := chr(Size);
  234.    L := length(Str);
  235.    if L <= Size then
  236.       move(Str[1],Temp[succ(Size - L)],L)
  237.    else
  238.       move(Str[1],Temp[1],size);
  239.    PadRight := Temp;
  240. end;
  241.  
  242. function Last(N:byte;Str:string):string;
  243. var Temp : string;
  244. begin
  245.    if N > length(Str) then
  246.       Temp := Str
  247.    else
  248.       Temp := copy(Str,succ(length(Str) - N),N);
  249.    Last := Temp;
  250. end;  {Last}
  251.  
  252. function First(N:byte;Str:string):string;
  253. var Temp : string;
  254. begin
  255.    if N > length(Str) then
  256.       Temp := Str
  257.    else
  258.       Temp := copy(Str,1,N);
  259.    First := Temp;
  260. end;  {First}
  261.  
  262. function AdjCase(NewCase:tCase;Str:string):string;
  263. {}
  264. begin
  265.    case Newcase of
  266.    Upper: Str := SetUpper(Str);
  267.    Lower: Str := SetLower(Str);
  268.    Proper: Str := SetProper(Str);
  269.    Leave:{do nothing};
  270.    end;
  271.    AdjCase := Str;
  272. end; {AdjCase}
  273.  
  274. function SetUpper(Str:string):string;
  275. var
  276.   I : integer;
  277. begin
  278.    for I := 1 to length(Str) do
  279.       Str[I] := AlphabetTOT^.GetUpcase(Str[I]);
  280.    SetUpper := Str;
  281. end;  {Upper}
  282.  
  283. function SetLower(Str:string):string;
  284. var
  285.   I : integer;
  286. begin
  287.    for I := 1 to length(Str) do
  288.       Str[I] := AlphabetTOT^.GetLocase(Str[I]);
  289.    SetLower := Str;
  290. end;  {Lower}
  291.  
  292. function SetProper(Str:string):string;
  293. var
  294.   I : integer;
  295.   SpaceBefore: boolean;
  296. begin
  297.    SpaceBefore :